home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MYUTIL / IMPMAKE.M < prev    next >
Encoding:
Text File  |  1989-03-10  |  8.3 KB  |  307 lines
  1. MODULE ImpMake; (*$ E MTP *)
  2.  
  3. (*
  4.  *                                          Hilfprogramm für Megamax Modula-2
  5.  *                                                  Thomas Tempelmann 26.8.88
  6.  *  Mini-Make
  7.  *  ---------
  8.  *  Schreibt alle Namen von Impl-Texten, deren Codes älter sind, in eine Datei.
  9.  *)
  10.  
  11. FROM SYSTEM IMPORT ADDRESS, ADR, TSIZE, BYTE, WORD, LONGWORD, VAL;
  12.  
  13. FROM Terminal IMPORT WriteLn, Read, WriteString, FlushKbd;
  14.  
  15. FROM ArgCV IMPORT PtrArgStr, InitArgCV;
  16.  
  17. FROM Clock IMPORT Time, Date, PackTime, PackDate, UnpackTime, UnpackDate;
  18.  
  19. FROM Directory IMPORT DirQuery, FileAttrSet, FileAttr, SetFileAttr, DirEntry,
  20.         SplitName;
  21.  
  22. FROM Paths IMPORT ListPos, SearchFile;
  23.  
  24. IMPORT Text;
  25.  
  26. FROM ShellMsg IMPORT ImpPaths;
  27.  
  28. FROM Files IMPORT File, Open, Create, Access, ReplaceMode, GetStateMsg,
  29.         State, Close, SetDateTime;
  30.  
  31. FROM Strings IMPORT String, Upper, Assign, Compare, Relation;
  32.  
  33. FROM FuncStrings IMPORT ConcStr;
  34.  
  35.  
  36. MODULE directory2; (* lokales Modul *)
  37.  
  38.   IMPORT DirEntry, UnpackDate, UnpackTime;
  39.  
  40.   EXPORT GetDirEntry; (* wird demnächst von 'Directory' exportiert *)
  41.  
  42.   PROCEDURE str0;
  43.     (*$L-*)
  44.     BEGIN
  45.       ASSEMBLER
  46.           ; D0: HIGH (s)
  47.           ; A0: ADR (s)
  48.           ; D2 erhalten !
  49.           MOVE.L  (A7)+,A1
  50.           
  51.           MOVE    D0,D1
  52.           ADDQ    #3,D1
  53.           BCLR    #0,D1
  54.           
  55.           ; LINK:
  56.           PEA     (A5)
  57.           MOVE.L  A7,A5
  58.           SUBA.W  D1,A7
  59.           
  60.           CMPA.L  A3,A7
  61.           BLS     E
  62.           MOVE.L  A7,A2
  63.           
  64.        L: MOVE.B  (A0)+,(A2)+
  65.           DBRA    D0,L
  66.           CLR.B   (A2)+
  67.           
  68.           MOVE.L  A7,D0
  69.           JMP     (A1)
  70.        
  71.        E: TRAP    #6      ; OUT OF STACK
  72.           DC.W    -10
  73.       END
  74.     END str0;
  75.     (*$L=*)
  76.   
  77.   PROCEDURE setDta;
  78.     (*$L-*)
  79.     BEGIN
  80.       ASSEMBLER
  81.           ; get old DTA
  82.           MOVE    #$2F,-(A7)
  83.           TRAP    #1
  84.           MOVE.L  D0,D3           ; alten DTA merken in D3
  85.           ; set new DTA
  86.           MOVE.L  D4,-(A7)
  87.           MOVE    #$1A,-(A7)
  88.           TRAP    #1
  89.           ADDQ.L  #8,A7
  90.       END
  91.     END setDta;
  92.     (*$L=*)
  93.   
  94.   PROCEDURE rstDta;
  95.     (*$L-*)
  96.     BEGIN
  97.       ASSEMBLER
  98.           ; reset old DTA, erhalte D0 !
  99.           MOVE.L  D0,-(A7)
  100.           MOVE.L  D3,-(A7)
  101.           MOVE    #$1A,-(A7)
  102.           TRAP    #1
  103.           ADDQ.L  #6,A7
  104.           MOVE.L  (A7)+,D0
  105.       END
  106.     END rstDta;
  107.     (*$L=*)
  108.   
  109.   PROCEDURE GetDirEntry (fileName: ARRAY OF CHAR;
  110.                          VAR entry: DirEntry ): BOOLEAN;
  111.     (*$L-*)
  112.     BEGIN
  113.       ASSEMBLER
  114.           MOVE.L  -10(A3),A0
  115.           MOVE.W  -06(A3),D0
  116.           JSR     str0
  117.           
  118.           MOVEM.L D3/D4,-(A7)
  119.           
  120.           ; DTA anlegen
  121.           SUBA.W  #44,A7
  122.           MOVE.L  A7,D4
  123.           
  124.           CLR.W   -(A7)           ; Attribut
  125.           MOVE.L  D0,-(A7)        ; zuerst D0 (^name) sichern
  126.           JSR     setDta          ; dann DTA sichern/umsetzen
  127.           MOVE    #$4E,-(A7)
  128.           TRAP    #1              ; FSFIRST
  129.           ADDQ.L  #8,A7
  130.           JSR     rstDta
  131.           
  132.           MOVE.L  -4(A3),A1       ; ADR (entry)
  133.           
  134.           ; Name in Dir vorhanden ?
  135.           TST.L   D0
  136.           BMI     fals
  137.           
  138.           ; Prüfen, ob es ein normales File ist (nicht Subdir/volID)
  139.           MOVE.B  21(A7),D0
  140.           ANDI    #11000%,D0
  141.           BNE     fals
  142.           
  143.           ; DirEntry kopieren, DTA ist direkt auf dem Systemstack
  144.           ; name
  145.           MOVEQ   #5,D0
  146.           LEA     $1E(A7),A0
  147.       L0: MOVE.W  (A0)+,(A1)+
  148.           DBRA    D0,L0
  149.           ; attr
  150.           MOVE.B  21(A7),(A1)+
  151.           CLR.B   (A1)+
  152.           ; time
  153.           MOVE    22(A7),(A3)+
  154.           MOVE.L  A1,-(A7)
  155.           JSR     UnpackTime
  156.           MOVE.L  (A7)+,A1
  157.           MOVE.L  -6(A3),(A1)+
  158.           MOVE.W  -(A3),(A1)+
  159.           SUBQ.L  #4,A3
  160.           ; date
  161.           MOVE    24(A7),(A3)+
  162.           MOVE.L  A1,-(A7)
  163.           JSR     UnpackDate
  164.           MOVE.L  (A7)+,A1
  165.           MOVE.L  -6(A3),(A1)+
  166.           MOVE.W  -(A3),(A1)+
  167.           SUBQ.L  #4,A3
  168.           ; size
  169.           MOVE.L  26(A7),(A1)+
  170.           MOVEQ   #1,D0
  171.           BRA     ende
  172.           
  173.         fals
  174.           ; entry löschen
  175.           MOVEQ   #14,D0
  176.       l1: CLR.W   (A1)+
  177.           DBRA    D0,l1
  178.           MOVEQ   #0,D0
  179.           
  180.         ende
  181.           SUBA.W  #10,A3          ; name + entry
  182.           ADDA.W  #44,A7
  183.           MOVEM.L (A7)+,D3/D4
  184.           UNLK    A5
  185.           MOVE    D0,(A3)+
  186.       END
  187.     END GetDirEntry;
  188.     (*$L=*)
  189.  
  190.   END directory2;  (* lokales Modul *)
  191.  
  192.  
  193. VAR     argv: ARRAY [0..3] OF PtrArgStr;
  194.         argc: CARDINAL;
  195.         open: BOOLEAN;
  196.         f: File;
  197.  
  198. PROCEDURE showErr ( i: INTEGER );
  199.   VAR msg: ARRAY [0..31] OF CHAR;
  200.   BEGIN
  201.     WriteLn;
  202.     WriteString ('Fehler: ');
  203.     GetStateMsg ( i, msg );
  204.     WriteString ( msg );
  205.     WriteLn;
  206.   END showErr;
  207.  
  208. PROCEDURE wait;
  209.   VAR c: CHAR;
  210.   BEGIN
  211.     WriteLn;
  212.     WriteString ('Taste...');
  213.     FlushKbd;
  214.     Read (c)
  215.   END wait;
  216.  
  217. PROCEDURE query ( path: ARRAY OF CHAR; entry: DirEntry ): BOOLEAN;
  218.  
  219.   VAR name: String;
  220.       comp, exist: BOOLEAN;
  221.       de: DirEntry;
  222.       sfx: ARRAY [0..2] OF CHAR;
  223.  
  224.   BEGIN
  225.     (* nur normale Dateien - keine Subdirs, Volume-Labels *)
  226.     IF entry.attr * FileAttrSet{volLabelAttr,subdirAttr} = FileAttrSet{} THEN
  227.       (* Suffix von Quellnamen entfernen *)
  228.       SplitName (entry.name, name, sfx);
  229.       (* Nach der zugehörigen Codedatei auf den Impl-Pfaden suchen *)
  230.       SearchFile ( ConcStr (name, '.IMP'), ImpPaths, fromStart, exist, name);
  231.       comp:= FALSE;
  232.       IF NOT exist THEN
  233.         (* Quelltext sollte compiliert werden *)
  234.         comp:= TRUE
  235.       ELSE
  236.         (* Datum und Zeit der beiden Dateien vergleichen *)
  237.         IF  GetDirEntry ( name, de )
  238.         AND (   (PackDate(entry.date)>PackDate(de.date))
  239.              OR (    (PackDate(entry.date)=PackDate(de.date))
  240.                  AND (PackTime(entry.time)>PackTime(de.time)) ) ) THEN
  241.           (* Quelltext muß neu compiliert werden *)
  242.           comp:= TRUE
  243.         END
  244.       END;
  245.       IF comp THEN
  246.         (* ggf. die Make-Datei eröffnen *)
  247.         IF NOT open THEN
  248.           Create (f, argv[2]^, writeOnly, replaceOld);
  249.           Text.WriteLn (f);
  250.           open:= TRUE;
  251.         END;
  252.         (* Inlcude-Anweisung in Make-Datei schreiben *)
  253.         Text.WriteString (f, '(*$Q+, I ');
  254.         Text.WriteString (f, path);
  255.         Text.WriteString (f, entry.name);
  256.         Text.WriteString (f, ' *)');
  257.         IF NOT exist THEN
  258.           Text.WriteString (f, '  (* noch kein Code *)')
  259.         END;
  260.         Text.WriteLn (f);
  261.       END
  262.     END;
  263.     RETURN TRUE (* Die nächste, bitte *)
  264.   END query;
  265.  
  266.  
  267. PROCEDURE usage;
  268.   BEGIN
  269.     WriteLn;
  270.     WriteString ('Aufruf: IMPMAKE impPfad makeDatei');
  271.     WriteLn;
  272.     WriteString
  273.       ("        Erzeugt makeDatei für alle neuen '*.I' auf dem impPfad.");
  274.     WriteLn;
  275.   END usage;
  276.  
  277.  
  278. VAR     result: INTEGER;
  279.         ok: BOOLEAN;
  280.  
  281. BEGIN
  282.   InitArgCV ( argc, argv );
  283.   IF argc = 3 THEN
  284.     (* Alle Implementationstexte prüfen... *)
  285.     Upper (argv[1]^);
  286.     DirQuery ( ConcStr (argv[1]^, '*.I'), FileAttrSet {}, query, result );
  287.     IF open THEN
  288.       (* Make-Datei wurde erzeugt und muß nun geschlossen werden *)
  289.       Close (f)
  290.     ELSE
  291.       (* Keine Make-Datei erzeugt *)
  292.       WriteString ('Keine Implementationen aus ');
  293.       WriteString (argv[1]^);
  294.       WriteString (' zu compilieren.');
  295.       WriteLn;
  296.       wait
  297.     END;
  298.     (* War Fehler bei 'DirQuery ?' *)
  299.     IF result < 0 THEN showErr ( result ); wait END
  300.   ELSE
  301.     usage;
  302.     wait
  303.   END;
  304. END ImpMake.
  306. (* $FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$00001817$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78$FFF6AD78Ç$00001840T.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$FFF6C864$00001841$000017DA$00001801$00001840$000014F2$00001786$000017BB$00001839$00001819$0000179B$00001801$000017EF$000017DA$00001819$00001801öÇÇ*)
  307.